home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / src / Graphics.p < prev    next >
Encoding:
Text File  |  1996-10-29  |  59.2 KB  |  2,283 lines  |  [TEXT/CWIE]
  1. unit Graphics;
  2.  
  3. {Graphics routines used by NIH Image}
  4.  
  5. interface
  6.  
  7.     uses
  8.         Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts, Controls, Scrap, ToolUtils,
  9.         Dialogs, TextUtils, Windows, MixedMode, Palettes, Printing, TextEdit, globals, Utilities;
  10.  
  11.     procedure ShowLineWidth;
  12.     function GetInterpolatedPixel (x, y: extended): extended;
  13.     procedure GetObliqueLine (xstart, ystart, start, angle: extended; count: integer; var line: rLineType);
  14.     procedure GetLengthOrPerimeter (var ulength, clength: extended);
  15.     procedure PlotLineProfile;
  16.     procedure PlotArbitraryLine;
  17.     procedure DrawPlot;
  18.     procedure UpdatePlotWindow;
  19.     procedure ShowInfo;
  20.     procedure ComputePlotMinAndMax;
  21.     procedure SetupPlot (start: point; VerticalPlot: boolean);
  22.     procedure MakePlotWindow (PlotLeft, PlotTop, PlotWidth, PlotHeight: integer);
  23.     procedure DrawObject (obj: ObjectType; p1, p2: point);
  24.     procedure DrawTools;
  25.     function InvertingCalibrationFunction: boolean;
  26.     procedure DrawHistogram;
  27.     procedure DrawLabels (xL, yL, zL: str255);
  28.     procedure ShowNextImage;
  29.     procedure CascadeImages;
  30.     procedure TileImages;
  31.     function Duplicate (name: str255; SavingBlankField: boolean): boolean;
  32.     procedure InvertPic;
  33.     procedure ShowMessage (str: str255);
  34.     procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
  35.     procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
  36.     procedure ConvertHistoToText;
  37.     procedure ConvertPlotToText;
  38.     procedure ConvertCalibrationCurveToText;
  39.     procedure SetupUndoInfoRec;
  40.     procedure ActivateWindow;
  41.     procedure UpdateResultsWindow;
  42.     procedure ScrollResultsText;
  43.     procedure UpdateResultsScrollBars;
  44.     procedure InitResultsTextEdit (font, size: integer);
  45.     procedure DoMouseDownInResults (loc: point);
  46.     procedure AppendResults;
  47.     procedure DeleteLines (first, last: integer);
  48.     procedure UpdateList;
  49.     procedure ShowMeter;
  50.     procedure UpdateMeter (percentdone: integer; str: str255);
  51.     function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean;
  52.     procedure MakeCoordinatesRelative;
  53.     procedure MakeOutline (RoiKind: RoiTypeType);
  54.     procedure ConvertCoordinates;
  55.     function CoordinatesAvailable: boolean;
  56.     function CoordinatesAvailableMsg: boolean;
  57.     procedure DrawDropBox (r: rect);
  58.     function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  59.     procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  60.     procedure DrawPopUpText (str: str255; r: rect);
  61.     procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  62.     procedure RemoveDensityCalibration;
  63.     function isInvertingFunction:boolean;
  64.     function CheckCalibration: boolean;
  65.     procedure PlotTooLongMsg;
  66.  
  67.  
  68.  
  69. implementation
  70.  
  71.  
  72. {$PUSH}
  73. {$D-}
  74.  
  75.     procedure DrawJustifiedReal (x, y: integer; r: extended);
  76.   {Draws a right justified real number.}
  77.         var
  78.             str: str255;
  79.             digits: integer;
  80.     begin
  81.         if abs(r) >= 1000.0 then
  82.             digits := 0
  83.         else
  84.             digits := 2;
  85.         RealToString(r, 1, digits, str);
  86.         MoveTo(x - StringWidth(str), y);
  87.         DrawString(str);
  88.     end;
  89.  
  90.  
  91.     procedure DrawVerticalString (x, y: integer; str: str255);
  92.         var
  93.             i: integer;
  94.     begin
  95.         MoveTo(x, y);
  96.         for i := 1 to length(str) do begin
  97.                 MoveTo(x, y);
  98.                 DrawChar(str[i]);
  99.                 y := y + 9;
  100.             end;
  101.     end;
  102.  
  103.  
  104.     procedure LabelProfilePlot;
  105.         var
  106.             str: str255;
  107.             min, max: extended;
  108.             x, y: integer;
  109.     begin
  110.         min := PlotMin;
  111.         max := PlotMax;
  112.         DrawJustifiedReal(PlotLeftMargin - 2, PlotHeight - PlotBottomMargin, min);
  113.         DrawJustifiedReal(PlotLeftMargin - 2, PlotTopMargin + 8, max);
  114.         y := PlotTopMargin + (PlotHeight - (PlotTopMargin + PlotBottomMargin)) div 2 - length(PlotYUnits) * 9 div 2 + 6;
  115.         DrawVerticalString(PlotLeftMargin - 15, y, PlotYUnits);
  116.         MoveTo(PlotLeftMargin, PlotHeight - PlotBottomMargin + 11);
  117.         DrawLong(0);
  118.         if PlotScale <> 0.0 then
  119.             RealToString((PlotCount - 1) * PlotScale, 1, Precision, str)
  120.         else
  121.             NumToString(PlotCount - 1, str);
  122.         MoveTo(PlotWidth - PlotRightMargin - StringWidth(str) + 4, PlotHeight - PlotBottomMargin + 11);
  123.         DrawString(str);
  124.         x := PlotRightMargin + (PlotWidth - (PlotRightMargin + PlotLeftMargin)) div 2 - StringWidth(str) div 2;
  125.         MoveTo(x, PlotHeight - PlotBottomMargin + 13);
  126.         DrawString(PlotXUnits);
  127.     end;
  128.  
  129.  
  130.     procedure LabelCalibrationPlot;
  131.         var
  132.             pbottom, hloc, vloc, i: integer;
  133.             letter: packed array[1..6] of char;
  134.             c:char;
  135.     begin
  136.         pbottom := PlotHeight - PLotBottomMargin;
  137.         DrawJReal(PlotLeftMargin, PlotTopMargin + 4, maxCValue, 2);
  138.         DrawJReal(PlotLeftMargin, pbottom, minCValue, 2);
  139.         MoveTo(PlotLeftMargin - 3, pbottom + 10);
  140.         DrawString('0');
  141.         MoveTo(PlotWidth - PlotRightMargin - 14, pbottom + 10);
  142.         DrawString('255');
  143.         MoveTo(PlotLeftMargin + 15, PlotTopMargin + 15);
  144.         TextSize(12);
  145.         case info^.fit of
  146.             StraightLine: 
  147.                 DrawString('y=a+bx');
  148.             Poly2: 
  149.                 DrawString('y=a+bx+cx^2');
  150.             Poly3: 
  151.                 DrawString('y=a+bx+cx^2+dx^3');
  152.             Poly4: 
  153.                 DrawString('y=a+bx+cx^2+dx^3+ex^4');
  154.             Poly5: 
  155.                 DrawString('y=a+bx+cx^2+dx^3+ex^4+fx^5');
  156.             ExpoFit: 
  157.                 DrawString('y=aexp(bx)');
  158.             PowerFit: 
  159.                 DrawString('y=ax^b');
  160.             LogFit: 
  161.                 DrawString('y=aln(bx)');
  162.             RodbardFit: 
  163.                 DrawString('y=c*((a-x)/(x-d))^(1/b)');
  164.             UncalibratedOD: 
  165.                 DrawString('y=log10(255/(255-x))');
  166.             otherwise
  167.         end;
  168.         hloc := PlotWidth - PlotRightMargin + 5;
  169.         vloc := PlotTopMargin + 25;
  170.         letter := 'abcdef';
  171.         MoveTo(hloc, vloc);
  172.         with info^ do
  173.             for i := 1 to nCoefficients do begin
  174.                     MoveTo(hloc, vloc);
  175.                     TextSize(12);
  176.                     c:=letter[i];
  177.                     DrawString(c);
  178.                     DrawString('=');
  179.                     TextSize(9);
  180.                     DrawReal(Coefficient[i], 1, 8);
  181.                     vloc := vloc + 15;
  182.                 end;
  183.         if info^.fit <> UncalibratedOD then begin
  184.                 vloc := vloc + 25;
  185.                 MoveTo(hloc, vloc);
  186.                 DrawString('S.D.=');
  187.                 DrawReal(FitSD, 1, 4);
  188.                 vloc := vloc + 15;
  189.                 MoveTo(hloc, vloc);
  190.                 DrawString('R^2=');
  191.                 DrawReal(FitGoodness, 1, 4);
  192.             end;
  193.     end;
  194.  
  195.  
  196.     procedure DrawPlot;
  197.         var
  198.             fRect: rect;
  199.     begin
  200.         SetRect(fRect, PlotLeftMargin, PlotTopMargin, PlotWidth - PlotRightMargin, PlotHeight - PlotBottomMargin);
  201.         PenNormal;
  202.         FrameRect(fRect);
  203.         DrawPicture(PlotPICT, fRect);
  204.         TextFont(Geneva);
  205.         TextSize(9);
  206.         if WindowPeek(PlotWindow)^.WindowKind = ProfilePlotKind then begin
  207.                 if DrawPlotLabels then
  208.                     LabelProfilePlot
  209.             end
  210.         else
  211.             LabelCalibrationPlot;
  212.     end;
  213.  
  214.  
  215.     procedure UpdatePlotWindow;
  216.     begin
  217.         SetPort(PlotWindow);
  218.         EraseRect(PlotWindow^.portRect);
  219.         DrawPlot;
  220.         DrawMyGrowIcon(PlotWindow);
  221.     end;
  222.  
  223.  
  224.     procedure MakePlotWindow; {(PlotLeft, PlotTop, PlotWidth, PlotHeight: integer)}
  225.         var
  226.             PLotRect, pwrect, dwrect, srect: rect;
  227.             overlapping: boolean;
  228.     begin
  229.         if PlotWindow = nil then begin
  230.                 SetRect(PlotRect, PlotLeft, PlotTop, PlotLeft + PlotWidth, PlotTop + PlotHeight);
  231.                 PlotWindow := NewWindow(nil, PlotRect, 'Plot', true, DocumentProc, nil, true, 0);
  232.             end
  233.         else begin
  234.                 GetWindowRect(PlotWindow, pwrect);
  235.                 GetWindowRect(info^.wptr, dwrect);
  236.                 overlapping := SectRect(pwrect, dwrect, srect);
  237.                 if overlapping then
  238.                     MoveWindow(PlotWindow, PlotLeft, PlotTop, false);
  239.                 SizeWindow(PlotWindow, PlotWidth, PlotHeight, false);
  240.             end;
  241.     end;
  242.  
  243.  
  244.     procedure GetDiagLine (start, finish: Point; var count: integer; var data: LineType; OptionKey: boolean);
  245.         var
  246.             sum: LongInt;
  247.             p: ptr;
  248.             deltax, deltay, xinc, yinc, accumulator, i: LongInt;
  249.             xloc, yloc, j: LongInt;
  250.             average: boolean;
  251.             buf, fline: LineType;
  252.     begin
  253.         average := LineWidth > 1;
  254.         if OptionKey and average then
  255.             for i := 0 to MaxLine do
  256.                 fline[i] := ForegroundIndex;
  257.         count := 0;
  258.         xloc := start.h;
  259.         yloc := start.v;
  260.         deltax := finish.h - xloc;
  261.         deltay := finish.v - yloc;
  262.         if (deltax = 0) and (deltay = 0) then begin
  263.                 data[count] := MyGetPixel(xloc, yloc);
  264.                 if OptionKey then
  265.                     PutPixel(xloc, yloc, ForegroundIndex);
  266.                 count := 1;
  267.                 exit(GetDiagLine);
  268.             end;
  269.         if deltax < 0 then begin
  270.                 xinc := -1;
  271.                 deltax := -deltax
  272.             end
  273.         else
  274.             xinc := 1;
  275.         if deltay < 0 then begin
  276.                 yinc := -1;
  277.                 deltay := -deltay
  278.             end
  279.         else
  280.             yinc := 1;
  281.         if DeltaX > DeltaY then begin {More horizontal}
  282.                 if average and (CurrentTool <> LineTool) then
  283.                     deltax := deltax + LineWidth;
  284.                 accumulator := deltax div 2;
  285.                 i := deltax;
  286.                 repeat
  287.                     if count < MaxLine then
  288.                         count := count + 1;
  289.                     accumulator := accumulator + deltay;
  290.                     if accumulator >= deltax then begin
  291.                             accumulator := accumulator - deltax;
  292.                             yloc := yloc + yinc
  293.                         end;
  294.                     xloc := xloc + xinc;
  295.                     if average then begin
  296.                             GetColumn(xloc, yloc, LineWidth, buf);
  297.                             if OptionKey then
  298.                                 PutColumn(xloc, yloc, LineWidth, fline);
  299.                             sum := 0;
  300.                             for j := 0 to LineWidth - 1 do
  301.                                 sum := sum + buf[j];
  302.                             data[count - 1] := round(sum / LineWidth);
  303.                         end
  304.                     else begin
  305.                             data[count - 1] := MyGetPixel(xloc, yloc);
  306.                             if OptionKey then
  307.                                 PutPixel(xloc, yloc, ForegroundIndex);
  308.                         end;
  309.                     i := i - 1;
  310.                 until i = 0
  311.             end
  312.         else begin          {More vertical}
  313.                 if average and (CurrentTool <> LineTool) then
  314.                     deltay := deltay + LineWidth;
  315.                 accumulator := deltay div 2;
  316.                 i := deltay;
  317.                 repeat
  318.                     if count < MaxLine then
  319.                         count := count + 1;
  320.                     accumulator := accumulator + deltax;
  321.                     if accumulator >= deltay then begin
  322.                             accumulator := accumulator - deltay;
  323.                             xloc := xloc + xinc
  324.                         end;
  325.                     yloc := yloc + yinc;
  326.                     if average then begin
  327.                             GetLine(xloc, yloc, LineWidth, buf);
  328.                             if OptionKey then
  329.                                 PutLine(xloc, yloc, LineWidth, fline);
  330.                             sum := 0;
  331.                             for j := 0 to LineWidth - 1 do
  332.                                 sum := sum + buf[j];
  333.                             data[count - 1] := round(sum / LineWidth);
  334.                         end
  335.                     else begin
  336.                             data[count - 1] := MyGetPixel(xloc, yloc);
  337.                             if OptionKey then
  338.                                 PutPixel(xloc, yloc, ForegroundIndex);
  339.                         end;
  340.                     i := i - 1;
  341.                 until i = 0
  342.             end;
  343.     end;
  344.  
  345.  
  346.     function GetInterpolatedPixel (x, y: extended): extended;
  347.   {Uses bilinear interpolation to computes the raw pixel value at real coordinates (x,y).}
  348.         var
  349.             i: integer;
  350.             xbase, ybase, offset: LongInt;
  351.             LowerLeft, LowerRight, UpperLeft, UpperRight: integer;
  352.             xfraction, yfraction, UpperAverage, LowerAverage: extended;
  353.     begin
  354.         xbase := trunc(x);
  355.         ybase := trunc(y);
  356.         xFraction := x - xbase;
  357.         yFraction := y - ybase;
  358.         with info^ do
  359.             if (xbase < 0) or (ybase < 0) or (xbase >= (PixelsPerLine - 1)) or (ybase >= (nlines - 1)) then begin
  360.                     LowerLeft := 0;
  361.                     LowerRight := 0;
  362.                     UpperLeft := 0;
  363.                     UpperRight := 0;
  364.                 end
  365.             else begin
  366.                     offset := ybase * BytesPerRow + xbase;
  367.                     LowerLeft := ImageP(PicBaseAddr)^[offset];
  368.                     LowerRight := ImageP(PicBaseAddr)^[offset + 1];
  369.                     UpperLeft := ImageP(PicBaseAddr)^[offset + BytesPerRow];
  370.                     UpperRight := ImageP(PicBaseAddr)^[offset + BytesPerRow + 1];
  371.                 end;
  372.         UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
  373.         LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
  374.         GetInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
  375.     end;
  376.  
  377.  
  378.     function GetCInterpolatedPixel (x, y: extended): extended;
  379.   {Uses bilinear interpolation to computes the calibrated pixel value at real coordinates (x,y).}
  380.         var
  381.             i, xbase, ybase: LongInt;
  382.             LowerLeft, LowerRight, UpperLeft, UpperRight: extended;
  383.             xfraction, yfraction, UpperAverage, LowerAverage: extended;
  384.     begin
  385.         xbase := trunc(x);
  386.         ybase := trunc(y);
  387.         xFraction := x - xbase;
  388.         yFraction := y - ybase;
  389.         LowerLeft := cvalue[MyGetPixel(xbase, ybase)];
  390.         LowerRight := cvalue[MyGetPixel(xbase + 1, ybase)];
  391.         UpperRight := cvalue[MyGetPixel(xbase + 1, ybase + 1)];
  392.         UpperLeft := cvalue[MyGetPixel(xbase, ybase + 1)];
  393.         UpperAverage := UpperLeft + xfraction * (UpperRight - UpperLeft);
  394.         LowerAverage := LowerLeft + xfraction * (LowerRight - LowerLeft);
  395.         GetCInterpolatedPixel := LowerAverage + yfraction * (UpperAverage - LowerAverage);
  396.     end;
  397.  
  398.  
  399.     procedure GetObliqueLine (xstart, ystart, start, angle: extended; count: integer; var line: rLineType);
  400.         var
  401.             i: integer;
  402.             x, y, xinc, yinc: extended;
  403.             IntegerStart: boolean;
  404.             tLine:LineType;
  405.     begin
  406.         IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
  407.         if IntegerStart and (angle = 0.0) then begin
  408.                 GetLine(trunc(xstart), trunc(ystart), count, tLine);
  409.                 for i := 0 to count - 1 do
  410.                     line[i] := cvalue[tLine[i]];
  411.                 exit(GetObliqueLine);
  412.             end;
  413.         if IntegerStart and (angle = 270.0) then begin
  414.                 GetColumn(trunc(xstart), trunc(ystart), count, tLine);
  415.                 for i := 0 to count - 1 do
  416.                     line[i] := cvalue[tLine[i]];
  417.                 exit(GetObliqueLine);
  418.             end;
  419.         angle := (angle / 180.0) * pi;
  420.         xinc := cos(angle);
  421.         yinc := -sin(angle);
  422.         x := xstart + start * xinc;
  423.         y := ystart + start * yinc;
  424.         if info^.fit <> uncalibrated then
  425.             for i := 0 to count - 1 do begin
  426.                     line[i] := GetCInterpolatedPixel(x, y);
  427.                     x := x + xinc;
  428.                     y := y + yinc;
  429.                 end
  430.         else
  431.             for i := 0 to count - 1 do begin
  432.                     line[i] := GetInterpolatedPixel(x, y);
  433.                     x := x + xinc;
  434.                     y := y + yinc;
  435.                 end;
  436.     end;
  437.  
  438.  
  439.     procedure DrawTools;
  440.         var
  441.             tPort: GrafPtr;
  442.             tool: ToolType;
  443.             tpRect, sRect, dRect: rect;
  444.             hloc, vloc: integer;
  445.  
  446.         procedure CopyToolBits (src, dst: rect; CopyMode: integer);
  447.         begin
  448.             CopyBits(toolBits, BitMapHandle(CGrafPtr(ToolWindow)^.PortPixMap)^^, src, dst, CopyMode, nil);
  449.         end;
  450.  
  451.     begin
  452.         GetPort(tPort);
  453.         SetPort(ToolWindow);
  454.         tpRect := CGrafPtr(ToolWindow)^.portRect;
  455.         SetFColor(BlackIndex);
  456.         SetBColor(WhiteIndex);
  457.         CopyToolBits(tpRect, tpRect, srcCopy);
  458.         case LOIType of
  459.             Straight: 
  460.                 ;
  461.             Freehand:  begin
  462.                     SetRect(sRect, 46, 92, 62, 106);
  463.                     hloc := 27;
  464.                     vloc := 92;
  465.                     SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
  466.                     CopyToolBits(sRect, dRect, SrcCopy);
  467.                 end;
  468.             Segmented:  begin
  469.                     SetRect(sRect, 46, 108, 62, 122);
  470.                     hloc := 27;
  471.                     vloc := 92;
  472.                     SetRect(dRect, hloc, vloc, hloc + 16, vloc + 14);
  473.                     CopyToolBits(sRect, dRect, SrcCopy);
  474.                 end;
  475.         end;
  476.         InvertRect(ToolRect[CurrentTool]);
  477.         SetRect(sRect, 46, 226, 55, 233);
  478.         hloc := 2;
  479.         vloc := Lines[LineIndex].top - 4;
  480.         SetRect(dRect, hloc, vloc, hloc + 9, vloc + 7);
  481.         CopyToolBits(sRect, dRect, SrcCopy); {Check mark}
  482.         SetFColor(ForegroundIndex);
  483.         SetRect(sRect, 46, 81, 57, 87);
  484.         hloc := 4;
  485.         vloc := 101;
  486.         SetRect(dRect, hloc, vloc, hloc + 11, vloc + 6);
  487.         CopyToolBits(sRect, dRect, SrcOr); {Brush color}
  488.         SetFColor(BackgroundIndex);
  489.         SetRect(sRect, 46, 65, 61, 76);
  490.         hloc := 3;
  491.         vloc := 73;
  492.         SetRect(dRect, hloc, vloc, hloc + 15, vloc + 11);
  493.         CopyToolBits(sRect, dRect, SrcOr); {Eraser color}
  494.         SetPort(tPort);
  495.     end;
  496.  
  497.  
  498.     procedure ShowLineWidth;
  499.     begin
  500.         LineIndex := LineWidth;
  501.         if LineWidth = 6 then
  502.             LineIndex := 5;
  503.         if LineWidth > 6 then
  504.             LineIndex := 6;
  505.         DrawTools;
  506.     end;
  507.  
  508.  
  509.     procedure GetFatLine (xstart, ystart, angle: extended; count: integer; var line: rLineType);
  510.         var
  511.             i, j, xbase, ybase: integer;
  512.             x, y, xinc, yinc, pAngle, xinc2, yinc2: extended;
  513.             sum, value: extended;
  514.             add: boolean;
  515.     begin
  516.         add := (angle > 90.0) and (angle <= 270.0);
  517.         angle := (angle / 180.0) * pi;
  518.         xinc := cos(angle);
  519.         yinc := -sin(angle);
  520.         if add then
  521.             pAngle := angle + pi / 2.0
  522.         else
  523.             pAngle := angle - pi / 2.0;
  524.         xinc2 := cos(pAngle);
  525.         yinc2 := -sin(pAngle);
  526.         for i := 0 to count - 1 do begin
  527.                 x := xstart;
  528.                 y := ystart;
  529.                 sum := 0.0;
  530.                 for j := 1 to LineWidth do begin
  531.                         if info^.fit <> uncalibrated then
  532.                             value := GetCInterpolatedPixel(x, y)
  533.                         else
  534.                             value := GetInterpolatedPixel(x, y);
  535.                         sum := sum + value;
  536.                         x := x + xinc2;
  537.                         y := y + yinc2;
  538.                     end;
  539.                 line[i] := sum / LineWidth;
  540.                 xstart := xstart + xinc;
  541.                 ystart := ystart + yinc;
  542.             end;
  543.     end;
  544.  
  545.  
  546.     procedure ComputePlotMinAndMax;
  547.         var
  548.             i: integer;
  549.             temp: extended;
  550.     begin
  551.         if InvertPlots then
  552.             for i := 0 to PlotCount - 1 do
  553.                 PlotData^[i] := maxCValue - (PlotData^[i] - minCValue);
  554.         ActualPlotMin := 10e12;
  555.         ActualPlotMax := -10e12;
  556.         for i := 0 to PlotCount - 1 do begin
  557.                 temp := PlotData^[i];
  558.                 if temp < ActualPlotMin then
  559.                     ActualPlotMin := temp;
  560.                 if temp > ActualPlotMax then
  561.                     ActualPlotMax := temp;
  562.             end;
  563.     end;
  564.  
  565.  
  566.     procedure SetupPlot (start: point; VerticalPlot: boolean);
  567.         const
  568.             MinWidth = 150;
  569.         var
  570.             fRect, trect: rect;
  571.             i, y, WindowWidth, fmax: integer;
  572.             SaveClipRegion: RgnHandle;
  573.             pt: point;
  574.             scale, vscale: extended;
  575.             AutoScale: boolean;
  576.             index: Byte;
  577.     begin
  578.         with info^ do begin
  579.                 PlotLeftMargin := 38;
  580.                 PlotTopMargin := 10;
  581.                 PlotBottomMargin := 20;
  582.                 PlotRightMargin := 20;
  583.                 if FixedSizePlot then begin
  584.                         PlotWidth := ProfilePlotWidth;
  585.                         PlotHeight := ProfilePlotHeight
  586.                     end
  587.                 else begin
  588.                         PlotWidth := PlotCount * trunc(magnification + 0.5);
  589.                         if PlotWidth < MinWidth then
  590.                             PlotWidth := MinWidth;
  591.                         if PlotWidth + PlotRightMargin + PicLeftBase > ScreenWidth then
  592.                             PlotWidth := ScreenWidth - PlotRightMargin - PicLeftBase - 10;
  593.                         if PlotWidth > PicRect.right then
  594.                             PlotWidth := PicRect.right;
  595.                         PlotHeight := PlotWidth div 2;
  596.                         if PlotWidth > 300 then
  597.                             PlotHeight := PlotWidth div 3;
  598.                         if PlotWidth > 400 then
  599.                             PlotHeight := PlotWidth div 4;
  600.                     end;
  601.                 PlotWidth := PlotWidth + PlotLeftMargin + PlotRightMargin;
  602.                 PlotHeight := PlotHeight + PlotTopMargin + PlotBottomMargin;
  603.                 OffscreenToScreen(start);
  604.                 pt.h := start.h;
  605.                 pt.v := start.v + 40;
  606.                 SetPort(wptr);
  607.                 LocalToGlobal(pt);
  608.                 if VerticalPlot then
  609.                     PlotLeft := PicLeftBase
  610.                 else
  611.                     PlotLeft := pt.h - PlotLeftMargin;
  612.                 PlotTop := pt.v;
  613.                 if PlotLeft > (ScreenWidth - PlotWidth) then
  614.                     PlotLeft := ScreenWidth - PlotWidth - 10;
  615.                 if PlotTop < 60 then
  616.                     PlotTop := 60;
  617.                 if PlotTop > (ScreenHeight - PlotHeight) then
  618.                     PlotTop := ScreenHeight - PlotHeight - 10;
  619.                 if PlotTop < 60 then
  620.                     PlotTop := 60;
  621.                 MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
  622.                 if PlotWindow = nil then
  623.                     exit(SetupPlot);
  624.                 WindowPeek(PlotWindow)^.WindowKind := ProfilePlotKind;
  625.                 if SpatiallyCalibrated then begin
  626.                         PlotScale := 1 / xScale;
  627.                         if xUnit = 'inch' then
  628.                             PlotXUnits := 'Inches'
  629.                         else if xUnit = 'meter' then
  630.                             PlotXUnits := 'meters'
  631.                         else if xUnit = 'mile' then
  632.                             PlotXUnits := 'miles'
  633.                         else
  634.                             PlotXUnits := xUnit;
  635.                     end
  636.                 else begin
  637.                         PlotScale := 0.0;
  638.                         PlotXUnits := 'Pixels'
  639.                     end;
  640.                 if fit <> uncalibrated then
  641.                     PlotYUnits := UnitOfMeasure
  642.                 else
  643.                     PlotYUnits := '';
  644.                 if AutoScalePlots then begin
  645.                         PlotMin := ActualPlotMin;
  646.                         PlotMax := ActualPlotMax;
  647.                     end
  648.                 else begin
  649.                         PlotMin := ProfilePlotMin;
  650.                         PlotMax := ProfilePlotMax;
  651.                     end;
  652.                 fmax := PlotCount - 1;
  653.                 if (PlotMax - PlotMin) <> 0 then
  654.                     vscale := fmax / (PlotMax - PlotMin)
  655.                 else
  656.                     vscale := 1.0;
  657.                 scale := 2048.0 / PlotCount;  {This scaling needed to get around a 32-bit QD problem}
  658.                 if scale < 1.0 then
  659.                     scale := 1.0;
  660.                 fmax := round(fmax * scale);
  661.                 vscale := vscale * scale;
  662.                 SetRect(fRect, 0, 0, fmax, fmax);
  663.                 SetPort(PlotWindow);
  664.                 SaveClipRegion := PlotWindow^.ClipRgn;
  665.                 RectRgn(PlotWindow^.ClipRgn, fRect);
  666.                 PlotPICT := OpenPicture(fRect);
  667.                 PenNormal;
  668.                 if LinePlot then begin
  669.                         MoveTo(0, round(vscale * (PlotMax - PlotData^[0])));
  670.                         for i := 1 to PlotCount - 1 do
  671.                             LineTo(round(i * scale), round(vscale * (PlotMax - PlotData^[i])))
  672.                     end
  673.                 else
  674.                     for i := 1 to PlotCount - 1 do begin
  675.                             y := round(vscale * (PlotMax - PlotData^[i]));
  676.                             MoveTo(round(i * scale), y);
  677.                             LineTo(round(i * scale), y)
  678.                         end;
  679.                 ClosePicture;
  680.                 PlotWindow^.ClipRgn := SaveClipRegion;
  681.                 InvalRect(PlotWindow^.PortRect);
  682.                 SelectWindow(PlotWindow);
  683.             end;  {with}
  684.     end;
  685.  
  686.  
  687.     procedure PlotLineProfile;
  688.         var
  689.             x1, y1, x2, y2, ulength, clength: extended;
  690.             start: point;
  691.             i, count:integer;
  692.     begin
  693.         GetLengthOrPerimeter(ulength, clength);
  694.         count := round(ulength);
  695.         if count = 0 then begin
  696.                 PutError('Line length is zero.');
  697.                 AbortMacro;
  698.                 exit(PlotLineProfile);
  699.             end;
  700.         if count > MaxLine then begin
  701.             PlotTooLongMsg;
  702.             exit(PlotLineProfile);
  703.         end;
  704.         PlotCount := count;
  705.         GetLoi(x1, y1, x2, y2);
  706.         PlotAngle := info^.LAngle;
  707.         if LineWidth > 1 then
  708.             GetFatLine(x1, y1, PlotAngle, PlotCount, PlotData^)
  709.         else
  710.             GetObliqueLine(x1, y1, 0.0, PlotAngle, PlotCount, PlotData^);
  711.         PlotAvg := LineWidth;
  712.         PlotStart.h := round(x1);
  713.         PlotStart.v := round(y1);
  714.         ComputePlotMinAndMax;
  715.         if ShowPlot then
  716.             SetupPlot(PlotStart, false);
  717.     end;
  718.  
  719.  
  720.     function CoordinatesAvailable: boolean;
  721.         var
  722.             available: boolean;
  723.     begin
  724.         with info^.RoiRect do
  725.             available := (nCoordinates > 0) and ((right - left) = CoordinatesWidth) and ((bottom - top) = CoordinatesHeight) and (info^.RoiType = CoordinatesRoiType);
  726.         if AnalyzingParticles and (nCoordinates > 0) then
  727.             available := true;
  728.         CoordinatesAvailable := available;
  729.     end;
  730.  
  731.  
  732.     function CoordinatesAvailableMsg: boolean;
  733.         var
  734.             available: boolean;
  735.     begin
  736.         available := CoordinatesAvailable;
  737.         if not available then
  738.             PutError('XY coordinates are not available.');
  739.         CoordinatesAvailableMsg := available;
  740.     end;
  741.  
  742.  
  743.     function GetArbitraryLine (var count: integer; var pdata: rLineType): boolean;
  744.         var
  745.             angle, length, leftover: extended;
  746.             i, j, ilength, xbase, ybase: integer;
  747.             x1, y1, x2, y2: LongInt;
  748.             data: rLineType;
  749.     begin
  750.         if not CoordinatesAvailableMsg or (nCoordinates < 2) then begin
  751.                 GetArbitraryLine := false;
  752.                 exit(GetArbitraryLine);
  753.             end;
  754.         count := 0;
  755.         length := 0.0;
  756.         leftover := 0.0;
  757.         with info^.RoiRect do begin
  758.                 xbase := left;
  759.                 ybase := top;
  760.             end;
  761.         for i := 2 to nCoordinates do begin
  762.                 x1 := xCoordinates^[i - 1] + xbase;
  763.                 y1 := yCoordinates^[i - 1] + ybase;
  764.                 x2 := xCoordinates^[i] + xbase;
  765.                 y2 := yCoordinates^[i] + ybase;
  766.                 length := sqrt(sqr(x2 - x1) + sqr(y2 - y1));
  767.                 if length > 0.0 then begin
  768.                         length := length - LeftOver;
  769.                         ilength := round(length);
  770.                         if ilength > 0 then begin
  771.                                 angle:=GetAngle(x2 - x1, y1 - y2);
  772.                                 GetObliqueLine(x1, y1, leftover, angle, ilength, data);
  773.                                 for j := 1 to ilength do begin
  774.                                         pdata[count] := data[j - 1];
  775.                                         if count < MaxLine then
  776.                                             count := count + 1;
  777.                                     end;
  778.                             end;
  779.                         leftover := length - ilength;
  780.                     end;
  781.             end;
  782.         GetArbitraryLine := true;
  783.     end;
  784.  
  785.  
  786.     procedure PlotArbitraryLine;
  787.         var
  788.             angle, length, leftover: extended;
  789.             x1, y1, x2, y2, i, j, count: integer;
  790.             data: LineType;
  791.     begin
  792.         if not GetArbitraryLine(PlotCount, PlotData^) then
  793.             exit(PlotArbitraryLine);
  794.         PlotAvg := 1;
  795.         with info^.RoiRect do begin
  796.                 PlotStart.h := left;
  797.                 PlotStart.v := top;
  798.             end;
  799.         ComputePlotMinAndMax;
  800.         if ShowPlot then
  801.             SetupPlot(PlotStart, false);
  802.     end;
  803.  
  804.  
  805.     procedure FindIntegratedDensity (var IntDen, Background: extended);
  806.         var
  807.             i, MinLevel, MaxLevel, iback: integer;
  808.             MaxCount: LongInt;
  809.             h, h2: HistogramType;
  810.             sum, wsum: extended;
  811.  
  812.         procedure SmoothHistogram;
  813.             var
  814.                 i: integer;
  815.         begin
  816.             h2 := h;
  817.             h[0] := (3 * h2[0] + h2[1]) div 5;
  818.             for i := 1 to 254 do
  819.                 h[i] := (h2[i - 1] + 2 * h2[i] + h2[i + 1]) div 4;
  820.         end;
  821.  
  822.     begin
  823.         with results do begin
  824.                 MinLevel := MinIndex;
  825.                 MaxLevel := round(UncalibratedMean);
  826.                 if MaxLevel > 254 then
  827.                     MaxLevel := 254;
  828.                 h := histogram;
  829.                 for i := 0 to 255 do
  830.                     h[i] := h[i] * 10;
  831.                 for i := 1 to 15 do
  832.                     SmoothHistogram;
  833.                 if OptionKeyDown then
  834.                     histogram := h;
  835.                 Background := 0.0;
  836.                 MaxCount := 0;
  837.                 for i := MinLevel to MaxLevel do
  838.                     if h[i] > MaxCount then begin
  839.                             MaxCount := h[i];
  840.                             Background := cvalue[i]
  841.                         end;
  842.                 IntDen := mArea^[mCount] * (mean^[mCount] - Background);
  843.             end;
  844.     end;
  845.  
  846.     procedure ShowInfo;
  847.         var
  848.             vloc, hloc: integer;
  849.             tPort: GrafPtr;
  850.             trect: rect;
  851.             clength, cx, cy, IntDen, BackgroundLevel: extended;
  852.             tUnit: UnitType;
  853.             TextStyle:style;
  854.  
  855.         procedure NewLine;
  856.         begin
  857.             vloc := vloc + 12;
  858.             MoveTo(hloc, vloc);
  859.         end;
  860.  
  861.     begin
  862.         GetPort(tPort);
  863.         vloc := 35;
  864.         hloc := 4;
  865.         SetPort(InfoWindow);
  866.         TextFont(Geneva);
  867.         TextSize(9);
  868.         Setrect(trect, 0, vloc, rwidth, rheight);
  869.         EraseRect(trect);
  870.         if InfoMessage <> '' then begin
  871.                 Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
  872.                 TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft)
  873.             end
  874.         else
  875.             with results do begin
  876.                     NewLine;
  877.                     with info^ do begin
  878.                             if ShowCount then begin
  879.                                     DrawBString('Count: ');
  880.                                     DrawLong(mCount);
  881.                                     NewLine;
  882.                                 end;
  883.                             if SpatiallyCalibrated then begin
  884.                                     DrawBString('Pixels: ');
  885.                                     DrawLong(PixelCount^[mCount]);
  886.                                     NewLine;
  887.                                     DrawBString('Area: ');
  888.                                     DrawReal(mArea^[mCount], 1, precision);
  889.                                     DrawString(' square ');
  890.                                     tUnit := xUnit;
  891.                                     if tUnit = 'inch' then
  892.                                         tUnit := 'Inches'
  893.                                     else if tUnit = 'meter' then
  894.                                         tUnit := 'meters'
  895.                                     else if tUnit = 'mile' then
  896.                                         tUnit := 'miles';
  897.                                     DrawString(tUnit);
  898.                                 end
  899.                             else begin
  900.                                     DrawBString('Area: ');
  901.                                     DrawLong(PixelCount^[mCount]);
  902.                                     DrawString(' square pixels');
  903.                                 end;
  904.                             NewLine;
  905.                             DrawBString('Mean: ');
  906.                             DrawReal(mean^[mCount], 1, precision);
  907.                             if fit <> uncalibrated then begin
  908.                                     DrawString(' ');
  909.                                     DrawBString(UnitOfMeasure);
  910.                                     DrawString('   (');
  911.                                     DrawLong(round(results.UncalibratedMean));
  912.                                     DrawString(')');
  913.                                 end;
  914.                             if PixelCount^[mCount] > 1 then begin
  915.                                     NewLine;
  916.                                     DrawBString('Std Dev: ');
  917.                                     DrawReal(sd^[mCount], 1, precision);
  918.                                     NewLine;
  919.                                     DrawBString('Min: ');
  920.                                     DrawReal(mMin^[mCount], 1, precision);
  921.                                     NewLine;
  922.                                     DrawBString('Max: ');
  923.                                     DrawReal(mMax^[mCount], 1, precision);
  924.                                 end;
  925.                             if (xyLocM in measurements) or (nPoints > 0) then begin
  926.                                     NewLine;
  927.                                     DrawBString('X: ');
  928.                                     DrawReal(xcenter^[mCount], 6, precision);
  929.                                     NewLine;
  930.                                     DrawBString('Y: ');
  931.                                     DrawReal(ycenter^[mCount], 6, precision);
  932.                                 end;
  933.                             if ModeM in Measurements then begin
  934.                                     NewLine;
  935.                                     DrawBString('Mode: ');
  936.                                     DrawReal(mode^[mCount], 1, precision);
  937.                                 end;
  938.                             if (LengthM in measurements) or (nLengths > 0) then begin
  939.                                     NewLine;
  940.                                     DrawBString('Length: ');
  941.                                     DrawReal(plength^[mCount], 1, precision);
  942.                                 end;
  943.                             if MajorAxisM in Measurements then begin
  944.                                     NewLine;
  945.                                     DrawBString(Concat(MajorLabel, ': '));
  946.                                     DrawReal(MajorAxis^[mCount], 1, precision);
  947.                                 end;
  948.                             if MinorAxisM in Measurements then begin
  949.                                     NewLine;
  950.                                     DrawBString(Concat(MinorLabel, ': '));
  951.                                     DrawReal(MinorAxis^[mCount], 1, precision);
  952.                                 end;
  953.                             if (AngleM in measurements) or (nAngles > 0) then begin
  954.                                     NewLine;
  955.                                     DrawBString('Angle: ');
  956.                                     DrawReal(orientation^[mCount], 1, precision);
  957.                                 end;
  958.                             if IntDenM in measurements then begin
  959.                                     NewLine;
  960.                                     FindIntegratedDensity(IntDen, BackgroundLevel);
  961.                                     DrawBString('Integrated Density: ');
  962.                                     DrawReal(IntDen, 1, precision);
  963.                                     NewLine;
  964.                                     DrawBString('Background Level: ');
  965.                                     DrawReal(BackGroundLevel, 1, precision);
  966.                                 end
  967.                             else begin
  968.                                     IntDen := 0.0;
  969.                                     BackGroundLevel := 0.0;
  970.                                 end;
  971.                             IntegratedDensity^[mCount] := IntDen;
  972.                             idBackground^[mCount] := BackGroundLevel;
  973.                             if User1M in Measurements then begin
  974.                                     NewLine;
  975.                                     DrawBString(Concat(User1Label, ': '));
  976.                                     DrawReal(User1^[mCount], 1, precision);
  977.                                 end;
  978.                             if User2M in Measurements then begin
  979.                                     NewLine;
  980.                                     DrawBString(Concat(User2Label, ': '));
  981.                                     DrawReal(User2^[mCount], 1, precision);
  982.                                 end;
  983.                         end;
  984.                 end; {with}
  985.         SetPort(tPort);
  986.         mCount2 := mCount;
  987.     end;
  988.  
  989.  
  990.     procedure PaintCircle (hloc, vloc: integer);
  991.         var
  992.             r: rect;
  993.     begin
  994.         SetRect(r, hloc, vloc, hloc + LineWidth, vloc + LineWidth);
  995.         PaintOval(r);
  996.     end;
  997.  
  998.  
  999.     procedure DrawBrush (start, finish: point);
  1000.   {Thanks to Robert Rimmer for suggesting the use of a line generator to implement the brush.}
  1001.         var
  1002.             deltax, deltay, xinc, yinc, accumulator, i: integer;
  1003.             xloc, yloc, offset, j: integer;
  1004.     begin
  1005.         xloc := start.h;
  1006.         yloc := start.v;
  1007.         deltax := finish.h - xloc;
  1008.         deltay := finish.v - yloc;
  1009.         if (deltax = 0) and (deltay = 0) then begin
  1010.                 PaintCircle(xloc, yloc);
  1011.                 exit(DrawBrush)
  1012.             end;
  1013.         if deltax < 0 then begin
  1014.                 xinc := -1;
  1015.                 deltax := -deltax
  1016.             end
  1017.         else
  1018.             xinc := 1;
  1019.         if deltay < 0 then begin
  1020.                 yinc := -1;
  1021.                 deltay := -deltay
  1022.             end
  1023.         else
  1024.             yinc := 1;
  1025.         if DeltaX > DeltaY then begin {More horizontal}
  1026.                 accumulator := deltax div 2;
  1027.                 i := deltax;
  1028.                 repeat
  1029.                     accumulator := accumulator + deltay;
  1030.                     if accumulator >= deltax then begin
  1031.                             accumulator := accumulator - deltax;
  1032.                             yloc := yloc + yinc
  1033.                         end;
  1034.                     xloc := xloc + xinc;
  1035.                     PaintCircle(xloc, yloc);
  1036.                     i := i - 1;
  1037.                 until i = 0
  1038.             end
  1039.         else begin          {More vertical}
  1040.                 accumulator := deltay div 2;
  1041.                 i := deltay;
  1042.                 repeat
  1043.                     accumulator := accumulator + deltax;
  1044.                     if accumulator >= deltay then begin
  1045.                             accumulator := accumulator - deltay;
  1046.                             xloc := xloc + xinc
  1047.                         end;
  1048.                     yloc := yloc + yinc;
  1049.                     PaintCircle(xloc, yloc);
  1050.                     i := i - 1;
  1051.                 until i = 0
  1052.             end;
  1053.     end;
  1054.  
  1055.  
  1056.     procedure DrawObject;{ (obj: ObjectType; p1, p2: point)}
  1057.         var
  1058.             MaskRect, r, dstRect, osMaskRect: rect;
  1059.             tPort: GrafPtr;
  1060.             tmp: integer;
  1061.             SaveGDevice: GDHandle;
  1062.     begin
  1063.         SaveGDevice := GetGDevice;
  1064.         GetPort(tPort);
  1065.         Pt2Rect(p1, p2, MaskRect);
  1066.         with Info^ do begin
  1067.                 changes := true;
  1068.                 tmp := trunc(magnification + 0.5) * LineWidth;
  1069.                 with MaskRect do begin
  1070.                         if tmp < 32 then
  1071.                             tmp := 32;
  1072.                         right := right + tmp;
  1073.                         bottom := bottom + tmp;
  1074.                         if magnification > 1.0 then begin
  1075.                                 left := left - tmp;
  1076.                                 top := top - tmp;
  1077.                             end;
  1078.                     end;
  1079.                 ScreenToOffscreen(p1);
  1080.                 ScreenToOffscreen(p2);
  1081.                 SetGDevice(osGDevice);
  1082.                 SetPort(GrafPtr(osPort));
  1083.                 pmForeColor(ForegroundIndex);
  1084.                 PenNormal;
  1085.                 PenSize(LineWidth, LineWidth);
  1086.                 case obj of
  1087.                     lineObj:  begin
  1088.                             MoveTo(p1.h, p1.v);
  1089.                             LineTo(p2.h, p2.v);
  1090.                         end;
  1091.                     Rectangle:  begin
  1092.                             Pt2Rect(p1, p2, r);
  1093.                             FrameRect(r);
  1094.                         end;
  1095.                     oval:  begin
  1096.                             Pt2Rect(p1, p2, r);
  1097.                             FrameOval(r);
  1098.                         end;
  1099.                     BrushObj: 
  1100.                         DrawBrush(p1, p2);
  1101.                 end;
  1102.                 SetGDevice(SaveGDevice);
  1103.                 SetPort(wptr);
  1104.                 SetFColor(BlackIndex);
  1105.                 SetBColor(WhiteIndex);
  1106.                 RectRgn(MaskRgn, MaskRect);
  1107.                 CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
  1108.                 SetPort(tPort);
  1109.             end; {with}
  1110.     end;
  1111.  
  1112.  
  1113.     function InvertingCalibrationFunction: boolean;
  1114.     begin
  1115.         with info^ do begin
  1116.                 InvertingCalibrationFunction := (fit = StraightLine) and (Coefficient[2] < 0.0)
  1117.             end;
  1118.     end;
  1119.  
  1120.  
  1121.     procedure DrawHistogram;
  1122.         var
  1123.             tPort: GrafPtr;
  1124.             i, h: integer;
  1125.             MaxCount, count, NextMaxCount: LongInt;
  1126.             str: str255;
  1127.             hscale: extended;
  1128.             ShowSlice: boolean;
  1129.     begin
  1130.         ShowSlice := (HistogramSliceStart > 0) or (HistogramSliceEnd < 255);
  1131.         if not printing then begin
  1132.                 if HistoWindow = nil then
  1133.                     exit(DrawHistogram);
  1134.                 GetPort(tPort);
  1135.                 SetPort(HistoWindow);
  1136.                 EraseRect(HistoWindow^.portRect);
  1137.             end;
  1138.         with Results do begin
  1139.                 MaxCount := histogram[imode];
  1140.                 if MaxCount > (hheight - 2) then begin
  1141.                         if MaxCount / PixelCount^[mCount] > 0.08 then begin
  1142.                                 NextMaxCount := 0;
  1143.                                 for i := 0 to 255 do begin
  1144.                                         count := histogram[i];
  1145.                                         if (i <> imode) and (count > NextMaxCount) then
  1146.                                             NextMaxCount := count;
  1147.                                     end;
  1148.                                 NextMaxCount := NextMaxCount + NextMaxCount div 2;
  1149.                                 if (NextMaxCount > MaxCount) or (NextMaxCount = 0) then
  1150.                                     NextMaxCount := MaxCount;
  1151.                                 hscale := NextMaxCount / (hheight - 2);
  1152.                             end
  1153.                         else
  1154.                             hscale := MaxCount / (hheight - 2);
  1155.                     end
  1156.                 else
  1157.                     hscale := 1.0;
  1158.                 if ShowSlice then
  1159.                     PenPat(qd.gray);
  1160.                 if InvertingCalibrationFunction then
  1161.                     for h := 0 to 255 do begin
  1162.                             if h = HistogramSliceStart then
  1163.                                 PenPat(qd.black);
  1164.                             MoveTo(255 - h, hheight);
  1165.                             LineTo(255 - h, hheight - round(histogram[h] / hscale));
  1166.                             if h = HistogramSliceEnd then
  1167.                                 PenPat(qd.gray)
  1168.                         end
  1169.                 else
  1170.                     for h := 0 to 255 do begin
  1171.                             if h = HistogramSliceStart then
  1172.                                 PenPat(qd.black);
  1173.                             MoveTo(h, hheight);
  1174.                             LineTo(h, hheight - round(histogram[h] / hscale));
  1175.                             if h = HistogramSliceEnd then
  1176.                                 PenPat(qd.gray)
  1177.                         end;
  1178.             end;
  1179.         if ShowSlice then
  1180.             PenNormal;
  1181.         if not Printing then
  1182.             SetPort(tPort);
  1183.     end;
  1184.  
  1185.  
  1186.     procedure DrawLabels (xL, yL, zL: str255);
  1187.    {Draws the labels(e.g.,  X:, Y:, Value:) used for the dynamically}
  1188.    {changing values displayed at the top of the Info window.}
  1189.         var
  1190.             tPort: GrafPtr;
  1191.             trect: rect;
  1192.             s:style;
  1193.     begin
  1194.         if xL = XLabel then
  1195.             if yL = yLabel then
  1196.                 if zL = zLabel then
  1197.                     exit(DrawLabels);
  1198.         GetPort(tPort);
  1199.         SetPort(InfoWindow);
  1200.         TextSize(9);
  1201.         TextFont(Monaco);
  1202.         TextFace([bold]);
  1203.         if length(xL) > 0 then begin
  1204.                 xLabel := xL;
  1205.                 xValueLoc := InfoHStart + StringWidth(xLabel);
  1206.                 yLabel := yL;
  1207.                 yValueLoc := InfoHStart + StringWidth(yLabel);
  1208.                 zLabel := zL;
  1209.                 zValueLoc := InfoHStart + StringWidth(zLabel);
  1210.             end;
  1211.         Setrect(trect, 0, 0, rwidth, 32);
  1212.         EraseRect(trect);
  1213.         MoveTo(InfoHStart, InfoVStart);
  1214.         DrawString(xLabel);
  1215.         MoveTo(InfoHStart, InfoVStart + 10);
  1216.         DrawString(yLabel);
  1217.         MoveTo(InfoHStart, InfoVStart + 19);
  1218.         DrawString(zLabel);
  1219.         s:=[];  {ppc-bug}
  1220.         TextFace(s);
  1221.         SetPort(tPort);
  1222.     end;
  1223.  
  1224.  
  1225.     procedure ShowNextImage;
  1226.         var
  1227.             n: integer;
  1228.     begin
  1229.         n := info^.PicNum + 1;
  1230.         if n > nPics then
  1231.             n := 1;
  1232.         SelectWindow(PicWindow[n]);
  1233.     end;
  1234.  
  1235.  
  1236.     procedure CascadeImages;
  1237.         var
  1238.             i, hloc, vloc, wwidth, wheight: integer;
  1239.             offset: boolean;
  1240.     begin
  1241.         DisableDensitySlice;
  1242.         hloc := PicLeftBase;
  1243.         vloc := PicTopBase;
  1244.         offset := not OptionKeyDown;
  1245.         for i := nPics downto 1 do begin
  1246.                 Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1247.                 with Info^ do begin
  1248.                         HideWindow(wptr);
  1249.                         ScaleToFitWindow := false;
  1250.                         WindowState := NormalWindow;
  1251.                         if offset then
  1252.                             wrect := initwrect
  1253.                         else begin
  1254.                                 wwidth := PixelsPerLine;
  1255.                                 if (hloc + wwidth) > ScreenWidth then
  1256.                                     wwidth := ScreenWidth - hloc - 5;
  1257.                                 wheight := nlines;
  1258.                                 if (vloc + wheight) > ScreenHeight then
  1259.                                     wheight := ScreenHeight - vloc - 5;
  1260.                                 SetRect(wrect, 0, 0, wwidth, wheight);
  1261.                             end;
  1262.                         SrcRect := wrect;
  1263.                         KillRoi;
  1264.                         magnification := 1.0;
  1265.                         if i = nPics then
  1266.                             DrawMyGrowIcon(wptr);
  1267.                         SizeWindow(wptr, wrect.right, wrect.bottom, true);
  1268.                         MoveWindow(wptr, hloc, vloc, true);
  1269.                         ShowWindow(wptr);
  1270.                         UpdateTitleBar;
  1271.                     end; {with}
  1272.                 if offset then begin
  1273.                         hloc := hloc + hPicOffset;
  1274.                         vloc := vloc + vPicOffset;
  1275.                         if (vloc + 40) > ScreenHeight then
  1276.                             vloc := PicTopBase;
  1277.                     end;
  1278.             end; {for}
  1279.         PicLeft := PicLeftBase;
  1280.         PicTop := PicTopBase;
  1281.         WhatToUndo := NothingToUndo;
  1282.     end;
  1283.  
  1284.  
  1285.     procedure TileImages;
  1286.         const
  1287.             gap = 2;
  1288.             TitleBarHeight = 20;
  1289.         var
  1290.             i, hloc, vloc, width, height, hspace, vspace, nRows, nColumns: integer;
  1291.             MinWidth, MinHeight: integer;
  1292.             tInfo: array[1..MaxPics] of InfoPtr;
  1293.             trect: rect;
  1294.             TheyFit: boolean;
  1295.     begin
  1296.         DisableDensitySlice;
  1297.         PicLeft := PicLeftBase;
  1298.         PicTop := PicTopBase;
  1299.         width := MaxInt;
  1300.         height := MaxInt;
  1301.         for i := 1 to nPics do begin
  1302.                 tInfo[i] := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1303.                 with tinfo[i]^.PicRect do begin
  1304.                         if right < width then
  1305.                             width := right;
  1306.                         if bottom < height then
  1307.                             height := bottom;
  1308.                     end;
  1309.             end;
  1310.         MinWidth := width;
  1311.         MinHeight := height;
  1312.         hspace := ScreenWidth - PicLeft - 2 * gap;
  1313.         if width > hspace then
  1314.             width := hspace;
  1315.         vspace := ScreenHeight - PicTop - TitleBarHeight;
  1316.         if height > vspace then
  1317.             height := vspace;
  1318.         repeat
  1319.             hloc := PicLeft;
  1320.             vloc := PicTop;
  1321.             TheyFit := true;
  1322.             i := 0;
  1323.             repeat
  1324.                 i := i + 1;
  1325.                 if (hloc + width) > ScreenWidth then begin
  1326.                         hloc := PicLeft;
  1327.                         vloc := vloc + TitleBarHeight + height;
  1328.                         if (vloc + height) > ScreenHeight then begin
  1329.                                 TheyFit := false;
  1330.                             end;
  1331.                     end;
  1332.                 hloc := hloc + width + gap;
  1333.             until (TheyFit = false) or (i = nPics);
  1334.             if TheyFit = false then begin
  1335.                     width := round(width * 0.98);
  1336.                     height := round(height * 0.98);
  1337.                 end;
  1338.         until TheyFit;
  1339.         nColumns := (ScreenWidth - PicLeft) div (width + gap);
  1340.         nRows := nPics div nColumns;
  1341.         if (nPics mod nColumns) <> 0 then
  1342.             nRows := nRows + 1;
  1343. {ShowMessage(concat('nRows= ', Long2str(nRows), crStr, 'nColumns= ', long2str(nColumns)));}
  1344.         if not OptionKeyWasDown then begin
  1345.                 width := round((ScreenWidth - PicLeft) / nColumns);
  1346.                 width := width - gap - 1;
  1347.                 height := round((ScreenHeight - PicTop) / nRows);
  1348.                 height := height - TitleBarHeight + 3;
  1349.                 if width > MinWidth then
  1350.                     width := MinWidth;
  1351.                 if height > MinHeight then
  1352.                     height := MinHeight;
  1353.             end;
  1354.         hloc := PicLeft;
  1355.         vloc := PicTop;
  1356.         for i := 1 to nPics do begin
  1357.                 if (hloc + width) > ScreenWidth then begin
  1358.                         hloc := PicLeft;
  1359.                         vloc := vloc + TitleBarHeight + height;
  1360.                     end;
  1361.                 Info := tInfo[i];
  1362.                 with Info^ do begin
  1363.                         SetRect(wrect, 0, 0, width, height);
  1364.                         if ScaleToFitWindow then begin
  1365.                                 ScaleToFitWindow := false;
  1366.                                 SrcRect := wrect;
  1367.                                 magnification := 1;
  1368.                                 WindowState := NormalWindow;
  1369.                             end;
  1370.                         if OptionKeyWasDown then begin
  1371.                                 ScaleToFitWindow := true;
  1372.                                 SrcRect := PicRect;
  1373.                                 ScaleImageWindow(wrect);
  1374.                                 WindowState := TiledSmallScaled;
  1375.                             end
  1376.                         else begin
  1377.                                 SrcRect := wrect;
  1378.                                 magnification := 1.0;
  1379.                                 UpdateTitleBar;
  1380.                                 WindowState := TiledSmall;
  1381.                             end;
  1382.                         SizeWindow(wptr, wrect.right, wrect.bottom, true);
  1383.                         KillRoi;
  1384.                         UpdatePicWindow;
  1385.                     end; {with}
  1386.                 MoveWindow(PicWindow[i], hloc, vloc, true);
  1387.                 hloc := hloc + width + gap;
  1388.         end; {for}
  1389.         WhatToUndo := NothingToUndo;
  1390.     end;
  1391.  
  1392.  
  1393.     function Duplicate (name: str255; SavingBlankField: boolean): boolean;
  1394.         var
  1395.             width, height, i, digit, len: integer;
  1396.             SaveInfo: InfoPtr;
  1397.             src, dst: ptr;
  1398.             hstart, vstart, offset: LongInt;
  1399.             AutoSelectAll: boolean;
  1400.     begin
  1401.         Duplicate := false;
  1402.         if nPics = MaxPics then
  1403.             exit(Duplicate);
  1404.         WhatToUndo := NothingToUndo;
  1405.         if (not SavingBlankField) and (NotRectangular or NotinBounds) then
  1406.             exit(Duplicate);
  1407.         AutoSelectAll := (not Info^.RoiShowing) or SavingBlankField;
  1408.         if AutoSelectAll then
  1409.             SelectAll(false);
  1410.         ShowWatch;
  1411.         with info^ do begin
  1412.                 if name = '' then begin
  1413.                         len := length(title);
  1414.                         if len > 0 then
  1415.                             digit := ord(title[len])
  1416.                         else
  1417.                             digit := 0;
  1418.                         if (len > 5) and (pos(' Copy', title) = (len - 4)) then
  1419.                             name := concat(title, ' 2')
  1420.                         else if (len > 7) and (pos(' Copy ', title) = (len - 6)) and (digit >= 49) and (digit <= 57) then begin
  1421.                             digit := digit +1;
  1422.                             if digit > 57 then
  1423.                                 digit := 49;
  1424.                             name := title;
  1425.                             name[length(name)] := chr(digit);
  1426.                         end else
  1427.                             name := concat(title, ' Copy');
  1428.                         TruncateString(name, maxTitle);
  1429.                     end;
  1430.                 with RoiRect do begin
  1431.                         width := right - left;
  1432.                         height := bottom - top;
  1433.                         hstart := left;
  1434.                         vstart := top;
  1435.                     end;
  1436.             end;
  1437.         if AutoSelectAll then
  1438.             KillRoi;
  1439.         SaveInfo := Info;
  1440.         if NewPicWindow(name, width, height) then
  1441.             with SaveInfo^ do begin
  1442.                     offset := vstart * BytesPerRow + hstart;
  1443.                     src := ptr(ord4(PicBaseAddr) + offset);
  1444.                     dst := Info^.PicBaseAddr;
  1445.                     for i := 0 to height - 1 do begin
  1446.                             BlockMove(src, dst, width);
  1447.                             src := ptr(ord4(src) + BytesPerRow);
  1448.                             dst := ptr(ord4(dst) + Info^.BytesPerRow);
  1449.                         end;
  1450.                     if SavingBlankField then begin
  1451.                             Info^.PIctureType := BlankField;
  1452.                             BlankFieldInfo := info;
  1453.                         end;
  1454.                     Duplicate := true;
  1455.                 end; {with}
  1456.     end;
  1457.  
  1458.  
  1459.     procedure InvertPic;
  1460.         var
  1461.             tPort: GrafPtr;
  1462.             SaveGDevice: GDHandle;
  1463.     begin
  1464.         SaveGDevice := GetGDevice;
  1465.         SetGDevice(osGDevice);
  1466.         GetPort(tPort);
  1467.         with Info^ do begin
  1468.                 SetPort(GrafPtr(osPort));
  1469.                 InvertRect(PicRect);
  1470.             end;
  1471.         SetPort(tPort);
  1472.         SetGDevice(SaveGDevice);
  1473.     end;
  1474.  
  1475.  
  1476.     procedure ShowMessage (str: str255);
  1477.     begin
  1478.         InfoMessage := str;
  1479.         ShowInfo;
  1480.     end;
  1481.  
  1482.  
  1483.     procedure ShowTime (StartTicks: LongInt; r: rect; str: str255);
  1484.         var
  1485.             width, height, nPixels: LongInt;
  1486.             seconds, rate: extended;
  1487.     begin
  1488.         with r do begin
  1489.                 width := right - left;
  1490.                 height := bottom - top;
  1491.                 nPixels := width * height;
  1492.             end;
  1493.         seconds := (TickCount - StartTicks) / 60.0;
  1494.         if seconds <> 0.0 then
  1495.             rate := nPixels / seconds
  1496.         else
  1497.             rate := 0.0;
  1498.         ShowMessage(StringOf(nPixels:1, ' pixels ', crStr, seconds:1:2, ' seconds', crStr, rate:1:0, ' pixels/second', crStr, str));
  1499.     end;
  1500.     
  1501.  
  1502.     procedure ShowFrameRate (str1: str255; StartTicks, nFrames: LongInt);
  1503.         var
  1504.             seconds: extended;
  1505.             str2: str255;
  1506.     begin
  1507.         seconds := (TickCount - StartTicks) / 60.0;
  1508.         if seconds = 0.0 then
  1509.             seconds := 0.167;
  1510.         RealToString(nFrames / seconds, 1, 2, str2);
  1511.         ShowMessage(concat(str1, str2, ' frames/second'));
  1512.     end;
  1513.  
  1514.  
  1515.     procedure ConvertHistoToText;
  1516.         var
  1517.             i: integer;
  1518.             ValuesInverted: boolean;
  1519.     begin
  1520.         ValuesInverted := InvertingCalibrationFunction;
  1521.         TextBufSize := 0;
  1522.         for i := 0 to 255 do begin
  1523.                 if ValuesInverted then
  1524.                     PutLong(Histogram[255 - i], 1)
  1525.                 else
  1526.                     PutLong(Histogram[i], 1);
  1527.                 if i <> 255 then
  1528.                     PutChar(cr);
  1529.             end;
  1530.     end;
  1531.  
  1532.  
  1533.     procedure ConvertPlotToText;
  1534.         var
  1535.             i: integer;
  1536.     begin
  1537.         TextBufSize := 0;
  1538.         for i := 0 to PlotCount - 1 do begin
  1539.                 PutReal(PlotData^[i], 1, precision);
  1540.                 if i <> PlotCount then
  1541.                     PutChar(cr);
  1542.             end;
  1543.     end;
  1544.  
  1545.  
  1546.     procedure ConvertCalibrationCurveToText;
  1547.         var
  1548.             i: integer;
  1549.     begin
  1550.         TextBufSize := 0;
  1551.         for i := 0 to 255 do begin
  1552.                 PutReal(cvalue[i], 1, 3);
  1553.                 if i <> 255 then
  1554.                     PutChar(cr);
  1555.             end;
  1556.     end;
  1557.  
  1558.  
  1559.     procedure SetupUndoInfoRec;
  1560. {Initialize the Undo buffer's Info record so we can copy}
  1561. {the current image to the Undo buffer and operate on it.}
  1562.     begin
  1563.         with UndoInfo^ do begin
  1564.                 PixelsPerLine := info^.PixelsPerLine;
  1565.                 BytesPerRow := info^.BytesPerRow;
  1566.                 nLines := Info^.nLines;
  1567.                 ImageSize := Info^.ImageSize;
  1568.                 PixMapSize := info^.PixMapSize;
  1569.                 RoiRect := info^.RoiRect;
  1570.                 CopyRgn(Info^.roiRgn, roiRgn);
  1571.                 roiType := Info^.roiType;
  1572.                 PicRect := Info^.PicRect;
  1573.                 with osPort^ do begin
  1574.                         with portPixMap^^ do begin
  1575.                                 RowBytes := BitOr(BytesPerRow, $8000);
  1576.                                 bounds := PicRect;
  1577.                             end;
  1578.                         PortRect := PicRect;
  1579.                         RectRgn(visRgn, PicRect);
  1580.                     end;
  1581.             end;
  1582.     end;
  1583.  
  1584.  
  1585. {$POP}
  1586.  
  1587.  
  1588.     procedure ActivateWindow;
  1589.         var
  1590.             tPort: GrafPtr;
  1591.             SaveGDevice: GDHandle;
  1592.     begin
  1593.         with info^ do begin
  1594.                 IsInsertionPoint := false;
  1595.                 WhatToUndo := NothingToUndo;
  1596.                 UndoFromClip := false;
  1597.                 DrawLabels('', '', '');
  1598.                 MouseState := NotInRoi;
  1599.                 RoiUpdateTime := 0;
  1600.                 if osPort <> nil then begin
  1601.                         SaveGDevice := GetGDevice;
  1602.                         SetGDevice(osGDevice);
  1603.                         GetPort(tPort);
  1604.                         SetPort(GrafPtr(osPort));
  1605.                         pmForeColor(ForegroundIndex);
  1606.                         pmBackColor(BackgroundIndex);
  1607.                         SetPort(tPort);
  1608.                         SetGDevice(SaveGDevice);
  1609.                     end;
  1610.                 ShowRoi;
  1611.             end;
  1612.     end;
  1613.  
  1614.  
  1615.     procedure UpdateResultsWindow;
  1616.     begin
  1617.         SetPort(ResultsWindow);
  1618.         DrawControls(ResultsWindow);
  1619.         DrawGrowIcon(ResultsWindow);
  1620.         UpdateList;
  1621.         if ResultsWindow = FrontWindow then begin
  1622.                 ShowControl(hScrollBar);
  1623.                 ShowControl(vScrollBar);
  1624.             end
  1625.         else begin
  1626.                 HideControl(hScrollBar);
  1627.                 HideControl(vScrollBar);
  1628.             end;
  1629.     end;
  1630.  
  1631.  
  1632.     procedure ScrollResultsText;
  1633.         var
  1634.             value: INTEGER;
  1635.     begin
  1636.         with ListTE^^ do
  1637.             TEScroll((viewRect.left - destRect.left) - GetControlValue(hScrollBar), (viewRect.top - destRect.top) - (GetControlValue(vScrollBar) * LineHeight), ListTE);
  1638.     end;
  1639.  
  1640.  
  1641.     procedure UpdateResultsScrollBars;
  1642.         var
  1643.             vMax, vValue, hMax, hValue: integer;
  1644.     begin
  1645.         with ListTE^^, ListTE^^.viewRect do begin
  1646.                 vListPageSize := (bottom - top) div LineHeight;
  1647.                 hListPageSize := right - left;
  1648.                 vMax := nLines - vListPageSize;
  1649.                 hMax := (nListColumns + 1) * (FieldWidth + 1) * 6 - hListPageSize;
  1650.                 vValue := (top - destRect.top) div LineHeight;
  1651.                 hValue := left - destRect.left
  1652.             end;
  1653.         if vMax < 0 then
  1654.             vMax := 0;
  1655.         if vValue < 0 then
  1656.             vValue := 0;
  1657.         if hMax < 0 then
  1658.             hMax := 0;
  1659.         if vValue < 0 then
  1660.             vValue := 0;
  1661.         SetControlMaximum(vScrollBar, vMax);
  1662.         SetControlValue(vScrollBar, vValue);
  1663.         SetControlMaximum(hScrollBar, hMax);
  1664.         SetControlValue(hScrollBar, hValue);
  1665. {ShowMessage(concat('nListColumns= ', Long2str(nListColumns), crStr, 'hListPageSize= ', long2str(hListPageSize)));}
  1666.     end;
  1667.  
  1668.  
  1669.     procedure ScrAction (theCtl: ControlHandle; partCode: integer);
  1670.         var
  1671.             bInc, pInc, delta: integer;
  1672.     begin
  1673.         if theCtl = vScrollBar then begin
  1674.                 bInc := 1;
  1675.                 pInc := vListPageSize
  1676.             end
  1677.         else begin
  1678.                 bInc := 4;
  1679.                 pInc := hListPageSize
  1680.             end;
  1681.         case partCode of
  1682.             kControlUpButtonPart: 
  1683.                 delta := -bInc;
  1684.             kControlDownButtonPart: 
  1685.                 delta := bInc;
  1686.             kControlPageUpPart: 
  1687.                 delta := -pInc;
  1688.             kControlPageDownPart: 
  1689.                 delta := pInc;
  1690.             otherwise
  1691.                 exit(ScrAction);
  1692.         end;
  1693.         SetControlValue(theCtl, GetControlValue(theCtl) + delta);
  1694.         ScrollResultsText;
  1695.     end;
  1696.  
  1697.  
  1698.     procedure InitResultsTextEdit (font, size: integer);
  1699.         var
  1700.             dRect, vRect: rect;
  1701.     begin
  1702.         if ResultsScrollActionProc=nil
  1703.             then ResultsScrollActionProc:=NewRoutineDescriptor(@ScrAction, uppControlActionProcInfo, GetCurrentISA);
  1704.         SetPort(ResultsWindow);
  1705.         with ResultsWindow^.portRect do
  1706.             SetRect(dRect, left + 4, top, right - 18, bottom - 24);
  1707.         vRect := dRect;
  1708.         ListTE := TENew(dRect, vRect);
  1709.         with ListTE^^ do begin
  1710.                 TxFont := font;
  1711.                 TxSize := size;
  1712.                 crOnly := -1;
  1713.             end;
  1714.         if TextBufSize > 0 then begin
  1715.                 TESetText(ptr(TextBufP), TextBufSize, ListTe);
  1716.                 TECalText(ListTE);
  1717.             end;
  1718.         UpdateResultsScrollBars;
  1719.     end;
  1720.  
  1721.  
  1722.     procedure DoMouseDownInResults (loc: point);
  1723.         var
  1724.             theCtl: ControlHandle;
  1725.             cValue: integer;
  1726.     begin
  1727.         SelectWindow(ResultsWindow);
  1728.         SetPort(ResultsWindow);
  1729.         GlobalToLocal(loc);
  1730.         case FindControl(loc, ResultsWindow, theCtl) of
  1731.             kControlUpButtonPart, kControlDownButtonPart, kControlPageUpPart, kControlPageDownPart: 
  1732.                 if TrackControl(theCtl, loc, ResultsScrollActionProc) <> 0 then
  1733.                     ;
  1734.             kControlIndicatorPart: 
  1735.                 if TrackControl(theCtl, loc, nil) <> 0 then
  1736.                     ScrollResultsText;
  1737.             otherwise
  1738.         end;
  1739.     end;
  1740.  
  1741.  
  1742.     procedure AppendResults;
  1743.         var
  1744.             vMax: integer;
  1745.     begin
  1746.         if ResultsWindow <> nil then
  1747.             with ListTE^^ do begin
  1748.                     if teLength > 32000 then
  1749.                         exit(AppendResults);
  1750.                     CopyResultsToBuffer(mCount, mCount, true);
  1751.                     TESetSelect(teLength, teLength, ListTE);
  1752.                     TEInsert(ptr(TextBufP), TextBufSize, ListTE);
  1753.                     with ListTE^^ do begin
  1754.                             vListPageSize := (viewRect.bottom - viewRect.top) div LineHeight;
  1755.                             vMax := nLines - vListPageSize;
  1756.                         end;
  1757.                     if vMax < 0 then
  1758.                         vMax := 0;
  1759.                     SetControlMaximum(vScrollBar, vMax);
  1760.                     SetControlValue(vScrollBar, GetControlMaximum(vScrollBar));
  1761.                     ScrollResultsText;
  1762.                 end;
  1763.     end;
  1764.  
  1765.  
  1766.     procedure DeleteLines (first, last: integer);
  1767.     begin
  1768.         if ResultsWindow <> nil then
  1769.             with ListTE^^ do begin
  1770.                     first := first + 2; {Accounts for 2 line header}
  1771.                     last := last + 2;
  1772.                     if (first = 3) and (last = 3) then
  1773.                         first := 1; {if deleting first line then delete header too}
  1774.                     if (first < 1) or (first > nLines) or (last < 1) or (last > nLines) then
  1775.                         exit(DeleteLines);
  1776.                     TESetSelect(LineStarts[first - 1], LineStarts[last], ListTE);
  1777.                     TEDelete(ListTE);
  1778.                 end;
  1779.     end;
  1780.  
  1781.  
  1782.     procedure UpdateList;
  1783.     begin
  1784.         if (ResultsWindow <> nil) and (mCount > 0) then
  1785.             with ListTE^^ do begin
  1786.                     CopyResultsToBuffer(1, mCount, true);
  1787.                     TESetSelect(0, teLength, ListTE);
  1788.                     TEDelete(ListTE);
  1789.                     TEInsert(ptr(TextBufP), TextBufSize, ListTE);
  1790.                     UpdateResultsScrollBars;
  1791.                 end;
  1792.     end;
  1793.  
  1794.  
  1795.     procedure ShowMeter;
  1796.         const
  1797.             MeterWidth = 264;
  1798.             MeterHeight = 64;
  1799.         var
  1800.             trect: rect;
  1801.             hloc, vloc: integer;
  1802.     begin
  1803.         hloc := ScreenWidth div 2 - MeterWidth div 2;
  1804.         vloc := ScreenHeight div 4 - MeterHeight div 2;
  1805.         SetRect(trect, hloc, vloc, hloc + MeterWidth, vloc + MeterHeight);
  1806.         MeterWindow := NewWindow(nil, trect, '', true, dBoxProc, nil, false, 0);
  1807.         BringToFront(MeterWindow);
  1808.     end;
  1809.  
  1810.  
  1811.     procedure UpdateMeter; {(percentdone: integer; str: str255)}
  1812.         const
  1813.             left = 16;
  1814.             top = 28;
  1815.             right = 248;
  1816.             bottom = 44;
  1817.         var
  1818.             r: rect;
  1819.     begin
  1820.         if percentdone < 0 then begin
  1821.             if MeterWindow <> nil then
  1822.                 DisposeWindow(MeterWindow);
  1823.             MeterWindow := nil;
  1824.             exit(UpdateMeter);
  1825.         end;
  1826.         if MeterWindow = nil then
  1827.             ShowMeter;
  1828.         SetPort(MeterWindow);
  1829.         TextFont(SystemFont);
  1830.         TextSize(12);
  1831.         TextMode(SrcCopy);
  1832.         MoveTo(left, top div 2);
  1833.         DrawString(str);
  1834.         SetRect(r, left + StringWidth(str), 0, right, top);
  1835.         EraseRect(r);
  1836.         SetRect(r, left, top, right, bottom);
  1837.         FrameRect(r);
  1838.         SetRect(r, left + 1, top + 1, left + (percentdone * (right - left)) div 100 - 1, bottom - 1);
  1839.         FillRect(r, qd.gray);
  1840.     end;
  1841.  
  1842.  
  1843.     function RgnNotTooBig; {(Rgn1, Rgn2: RgnHandle): boolean}
  1844.     begin
  1845.         RgnNotTooBig := GetHandleSize(handle(Rgn1)) + GetHandleSize(handle(Rgn2)) < 30000
  1846.     end;
  1847.  
  1848.  
  1849.     procedure GetSmoothedLength (var ulength, clength: extended; FindPerimeter: boolean);
  1850.   {Finds the length of freehand line selections or perimeter of}
  1851.   {freehand area selections using a 3-point moving average.}
  1852.         var
  1853.             i, n: integer;
  1854.             x1, y1, x2, y2, dx, dy: extended;
  1855.  
  1856.         procedure AddDelta;
  1857.         begin
  1858.             with info^ do begin
  1859.                     dx := x2 - x1;
  1860.                     dy := y2 - y1;
  1861.                     uLength := uLength + sqrt(dx * dx + dy * dy);
  1862.                     if SpatiallyCalibrated then begin
  1863.                             dx := dx / xScale;
  1864.                             dy := dy / yScale;
  1865.                             cLength := cLength + sqrt(dx * dx + dy * dy);
  1866.                         end;
  1867.                 end;
  1868.         end;
  1869.  
  1870.     begin
  1871.         with info^ do begin
  1872.                 uLength := 0.0;
  1873.                 cLength := 0.0;
  1874.                 n := nCoordinates;
  1875.                 if not CoordinatesAvailable then
  1876.                     exit(GetSmoothedLength);
  1877.                 if FindPerimeter then begin
  1878.                         x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
  1879.                         y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
  1880.                     end
  1881.                 else begin
  1882.                         x1 := (xCoordinates^[1] * 2.0 + xCoordinates^[2]) / 3.0; {1}
  1883.                         y1 := (yCoordinates^[1] * 2.0 + yCoordinates^[2]) / 3.0;
  1884.                     end;
  1885.                 x2 := (xCoordinates^[1] + xCoordinates^[2] + xCoordinates^[3]) / 3.0; {2}
  1886.                 y2 := (yCoordinates^[1] + yCoordinates^[2] + yCoordinates^[3]) / 3.0;
  1887.                 AddDelta;
  1888.                 for i := 2 to n - 2 do begin
  1889.                         x1 := x2; {i}
  1890.                         y1 := y2;
  1891.                         x2 := (xCoordinates^[i] + xCoordinates^[i + 1] + xCoordinates^[i + 2]) / 3.0; {i+1}
  1892.                         y2 := (yCoordinates^[i] + yCoordinates^[i + 1] + yCoordinates^[i + 2]) / 3.0;
  1893.                         AddDelta;
  1894.                     end;
  1895.                 x1 := x2; {n-1}
  1896.                 y1 := y2;
  1897.                 if FindPerimeter then begin
  1898.                         x2 := (xCoordinates^[n - 1] + xCoordinates^[n] + xCoordinates^[1]) / 3.0; {n}
  1899.                         y2 := (yCoordinates^[n - 1] + yCoordinates^[n] + yCoordinates^[1]) / 3.0;
  1900.                         AddDelta;
  1901.                         x1 := x2; {n}
  1902.                         y1 := y2;
  1903.                         x1 := (xCoordinates^[n] + xCoordinates^[1] + xCoordinates^[2]) / 3.0; {1}
  1904.                         y1 := (yCoordinates^[n] + yCoordinates^[1] + yCoordinates^[2]) / 3.0;
  1905.                         AddDelta;
  1906.                     end
  1907.                 else begin
  1908.                         x2 := (xCoordinates^[n - 1] + xCoordinates^[n] * 2.0) / 3.0; {n}
  1909.                         y2 := (yCoordinates^[n - 1] + yCoordinates^[n] * 2.0) / 3.0;
  1910.                         AddDelta;
  1911.                     end;
  1912.                 if not SpatiallyCalibrated then
  1913.                     cLength := uLength;
  1914.             end; {with}
  1915.     end;
  1916.  
  1917.  
  1918.     procedure GetPerimeter (var uPerimeter, cPerimeter: extended);
  1919.   {Finds the perimeter of traced objects.}
  1920.     var
  1921.       SideLength1, SideLength2: integer;
  1922.       dx1, dx2, dy1, dy2, i: integer;
  1923.       sumdx, sumdy, nCorners, nexti: integer;
  1924.       corner: boolean;
  1925.     begin
  1926.         sumdx := 0;
  1927.         sumdy := 0;
  1928.         nCorners := 0;
  1929.         dx1 := xCoordinates^[1] - xCoordinates^[nCoordinates];
  1930.         dy1 := yCoordinates^[1] - yCoordinates^[nCoordinates];
  1931.         SideLength1 := abs(dx1) + abs(dy1); {one of these is 0}
  1932.         corner := false;
  1933.         for i := 1 to nCoordinates do begin
  1934.             nexti := i + 1;
  1935.             if nexti > nCoordinates then
  1936.               nexti := 1;
  1937.             dx2 := xCoordinates^[nexti] - xCoordinates^[i];
  1938.             dy2 := yCoordinates^[nexti] - yCoordinates^[i];
  1939.             sumdx := sumdx + abs(dx1);
  1940.             sumdy := sumdy + abs(dy1);
  1941.             SideLength2 := abs(dx2) + abs(dy2);
  1942.             if (SideLength1 > 1) or (not corner) then begin
  1943.               corner := true;
  1944.               nCorners := nCorners + 1;
  1945.             end else
  1946.               corner := false;
  1947.             dx1 := dx2;
  1948.             dy1 := dy2;
  1949.             SideLength1 := SideLength2;
  1950.             end;
  1951.         uPerimeter := sumdx + sumdy - nCorners * (2.0 - sqrt(2.0));
  1952.         with info^ do
  1953.             if SpatiallyCalibrated then
  1954.                 cPerimeter := sumdx/xscale + sumdy/yscale - (nCorners * ((1.0/xscale + 1.0/yscale) - sqrt(sqr(1.0/xscale) + sqr(1.0/yscale))))
  1955.             else
  1956.                 cPerimeter := uPerimeter;
  1957.     end;
  1958.  
  1959.  
  1960.     procedure GetLength (var ulength, clength: extended; FindPerimeter: boolean);
  1961.   {Finds the length of segmented line selections or the perimeter of polygon selections.}
  1962.         var
  1963.             i: integer;
  1964.             xtemp, ytemp: LongInt;
  1965.             xt, yt: extended;
  1966.     begin
  1967.         with info^ do begin
  1968.                 uLength := 0.0;
  1969.                 cLength := 0.0;
  1970.                 if not CoordinatesAvailable then
  1971.                     exit(GetLength);
  1972.                 for i := 2 to nCoordinates do begin
  1973.                         xtemp := xCoordinates^[i] - xCoordinates^[i - 1];
  1974.                         ytemp := yCoordinates^[i] - yCoordinates^[i - 1];
  1975.                         uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
  1976.                         if SpatiallyCalibrated then begin
  1977.                                 xt := xtemp / xScale;
  1978.                                 yt := ytemp / yScale;
  1979.                                 cLength := cLength + sqrt(xt * xt + yt * yt);
  1980.                             end;
  1981.                     end;
  1982.                 if FindPerimeter then begin
  1983.                         xtemp := xCoordinates^[1] - xCoordinates^[nCoordinates];
  1984.                         ytemp := yCoordinates^[1] - yCoordinates^[nCoordinates];
  1985.                         uLength := uLength + sqrt(xtemp * xtemp + ytemp * ytemp);
  1986.                         if SpatiallyCalibrated then begin
  1987.                                 xt := xtemp / xScale;
  1988.                                 yt := ytemp / yScale;
  1989.                                 cLength := cLength + sqrt(xt * xt + yt * yt);
  1990.                             end;
  1991.                     end;
  1992.                 if not SpatiallyCalibrated then
  1993.                     cLength := uLength;
  1994.             end; {with}
  1995.     end;
  1996.  
  1997.  
  1998.     procedure GetStraightLineLength (var ulength, clength: extended);
  1999.         var
  2000.             dx, dy: extended;
  2001.     begin
  2002.         with info^ do begin
  2003.                 dx := LX2 - LX1;
  2004.                 dy := LY2 - LY1;
  2005.                 uLength := sqrt(sqr(dx) + sqr(dy));
  2006.                 if SpatiallyCalibrated then
  2007.                     cLength := sqrt(sqr(dx / xScale) + sqr(dy / yScale))
  2008.                 else
  2009.                     cLength := uLength;
  2010.             end;
  2011.     end;
  2012.  
  2013.  
  2014.     procedure GetLengthOrPerimeter (var ulength, clength: extended);
  2015.     var
  2016.         t1,t2:extended;
  2017.     begin
  2018.         t1:=ulength; t2:=clength;
  2019.         case info^.RoiType of
  2020.             LineRoi: 
  2021.                 GetStraightLineLength(ulength, clength);
  2022.             PolygonRoi:begin 
  2023.                 GetLength(t1, t2{ulength, clength}, true);  {ppc-bug}
  2024.                 ulength:=t1;
  2025.                 clength:=t2;
  2026.                 end;
  2027.             FreehandRoi:begin 
  2028.                 GetSmoothedLength(t1,t2{ulength, clength}, true);
  2029.                 ulength:=t1;
  2030.                 clength:=t2;
  2031.                 end;
  2032.             FreeLineRoi:begin 
  2033.                 GetSmoothedLength(t1,t2{ulength, clength}, false);
  2034.                 ulength:=t1;
  2035.                 clength:=t2;
  2036.                 end;
  2037.             SegLineRoi:begin 
  2038.                 GetLength(t1, t2{ulength, clength}, false);
  2039.                 ulength:=t1;
  2040.                 clength:=t2;
  2041.                 end;
  2042.             TracedRoi:begin 
  2043.                 GetPerimeter(t1,t2{ulength, clength});
  2044.                 ulength:=t1;
  2045.                 clength:=t2;
  2046.                 end;
  2047.             otherwise begin
  2048.                     ulength := 0.0;
  2049.                     clength := 0.0;
  2050.                 end;
  2051.         end;
  2052.     end;
  2053.  
  2054.  
  2055.     procedure MakeCoordinatesRelative;
  2056.         var
  2057.             i: integer;
  2058.     begin
  2059.         with info^, info^.RoiRect do begin
  2060.                 for i := 1 to nCoordinates do begin
  2061.                         xCoordinates^[i] := xCoordinates^[i] - left;
  2062.                         yCoordinates^[i] := yCoordinates^[i] - top;
  2063.                     end;
  2064.                 CoordinatesWidth := right - left;
  2065.                 CoordinatesHeight := bottom - top;
  2066.                 CoordinatesRoiType := RoiType;
  2067.             end;
  2068.     end;
  2069.  
  2070.  
  2071.     procedure MakeOutline (RoiKind: RoiTypeType);
  2072. {Creates a "marching ants" outline from a list of absolute offscreen XY coordinates.}
  2073.         var
  2074.             i: integer;
  2075.             TempRgn: RgnHandle;
  2076.             spt, pt: point;
  2077.     begin
  2078.         with Info^ do begin
  2079.                 if SelectionMode <> NewSelection then
  2080.                     TempRgn := NewRgn;
  2081.                 SetPort(wptr);
  2082.                 PenNormal;
  2083.                 OpenRgn;
  2084.                 spt.h := xCoordinates^[1];
  2085.                 spt.v := yCoordinates^[1];
  2086.                 MoveTo(spt.h, spt.v);
  2087.                 for i := 2 to nCoordinates do begin
  2088.                         pt.h := xCoordinates^[i];
  2089.                         pt.v := yCoordinates^[i];
  2090.                         LineTo(pt.h, pt.v);
  2091.                     end;
  2092.                 LineTo(spt.h, spt.v);
  2093.                 case SelectionMode of
  2094.                     NewSelection: 
  2095.                         CloseRgn(roiRgn);
  2096.                     AddSelection:  begin
  2097.                             CloseRgn(TempRgn);
  2098.                             if RgnNotTooBig(roiRgn, TempRgn) then
  2099.                                 UnionRgn(roiRgn, TempRgn, roiRgn);
  2100.                             nCoordinates := 0;
  2101.                         end;
  2102.                     SubSelection:  begin
  2103.                             CloseRgn(TempRgn);
  2104.                             if RgnNotTooBig(roiRgn, TempRgn) then
  2105.                                 DiffRgn(roiRgn, TempRgn, roiRgn);
  2106.                             nCoordinates := 0;
  2107.                         end;
  2108.                 end;
  2109.                 RoiShowing := true;
  2110.                 roiType := RoiKind;
  2111.                 RoiRect := roiRgn^^.rgnBBox;
  2112.                 UpdatePicWindow;
  2113.             end;
  2114.         if SelectionMode <> NewSelection then
  2115.             DisposeRgn(TempRgn);
  2116.         WhatToUndo := NothingToUndo;
  2117.         measuring := false;
  2118.         MakeCoordinatesRelative;
  2119.     end;
  2120.  
  2121.  
  2122.     procedure ConvertCoordinates;
  2123.   {Convert from screen to offscreen coordinates}
  2124.         var
  2125.             i: integer;
  2126.     begin
  2127.         with info^, info^.SrcRect do begin
  2128.                 if (magnification <> 1.0) or (left <> 0) or (top <> 0) then begin
  2129.                         if MakingLOI then
  2130.                             for i := 1 to nCoordinates do begin
  2131.                                     xCoordinates^[i] := left + trunc(xCoordinates^[i] / magnification);
  2132.                                     yCoordinates^[i] := top + trunc(yCoordinates^[i] / magnification);
  2133.                                 end
  2134.                         else
  2135.                             for i := 1 to nCoordinates do begin
  2136.                                     xCoordinates^[i] := left + round(xCoordinates^[i] / magnification);
  2137.                                     yCoordinates^[i] := top + round(yCoordinates^[i] / magnification);
  2138.                                 end;
  2139.                     end;
  2140.             end {with}
  2141.     end;
  2142.  
  2143.  
  2144.     procedure DrawTriangle (left, top: integer);
  2145.         var
  2146.             triangle: PolyHandle;
  2147.     begin
  2148.         triangle := OpenPoly;
  2149.         if triangle = nil then
  2150.             exit(DrawTriangle);
  2151.         MoveTo(left, top);
  2152.         LineTo(left + 12, top);
  2153.         LineTo(left + 6, top + 7);
  2154.         LineTo(left, top);
  2155.         ClosePoly;
  2156.         PaintPoly(triangle);
  2157.         KillPoly(triangle);
  2158.     end;
  2159.  
  2160.  
  2161.     procedure DrawDropBox (r: rect);
  2162.   {Draws the  drop shadow box used for pop-up menus}
  2163.     begin
  2164.         with r do begin
  2165.                 EraseRect(r);
  2166.                 FrameRect(r);
  2167.                 MoveTo(left + 2, bottom);
  2168.                 LineTo(right, bottom);
  2169.                 MoveTo(right, top + 2);
  2170.                 LineTo(right, bottom);
  2171.                 DrawTriangle(right - 15, top + 6);
  2172.             end;
  2173.     end;
  2174.  
  2175.  
  2176.     function PopUpMenu (theMenu: MenuHandle; left, top, PopUpItem: integer): integer;
  2177.   {Pops up the specified menu and returns item selected by user.}
  2178.         var
  2179.             PopupResult: LongInt;
  2180.             MenuLoc: point;
  2181.     begin
  2182.         with MenuLoc do begin
  2183.                 h := left;
  2184.                 v := top;
  2185.                 LocalToGlobal(MenuLoc);
  2186.                 PopUpResult := PopupMenuSelect(theMenu, v, h, PopUpItem);
  2187.                 PopUpMenu := LoWrd(PopUpResult);
  2188.             end;
  2189.     end;
  2190.  
  2191.  
  2192.     procedure GetDItemRect (d: DialogPtr; item: integer; var r: rect);
  2193.         var
  2194.             iType: integer;
  2195.             ignore: handle;
  2196.     begin
  2197.         GetDialogItem(d, item, itype, ignore, r)
  2198.     end;
  2199.  
  2200.  
  2201.     procedure DrawPopUpText (str: str255; r: rect);
  2202.         var
  2203.             TextRect: rect;
  2204.     begin
  2205.         with r do begin
  2206.                 TextFont(SystemFont);
  2207.                 if (str = '+') or (str = '–') or (str = '÷') then begin
  2208.                         TextSize(24);
  2209.                         MoveTo(left + 13, bottom - 2);
  2210.                     end
  2211.                 else begin
  2212.                         TextSize(12);
  2213.                         MoveTo(left + 13, bottom - 5);
  2214.                     end;
  2215.                 if length(str) = 1 then
  2216.                     DrawString(str)
  2217.                 else begin
  2218.                         SetRect(TextRect, left + 13, top + 1, right - 15, bottom - 1);
  2219.                         TETextBox(pointer(ord(@str) + 1), length(str), TextRect, TEJustLeft);
  2220.                     end;
  2221.             end;
  2222.         TextSize(12);
  2223.     end;
  2224.  
  2225.     procedure SetUProc (d: DialogPtr; item: integer; pptr: handle);
  2226.         var
  2227.             itype: integer;
  2228.             r: rect;
  2229.             h: handle;
  2230.     begin
  2231.         GetDialogItem(d, item, itype, h, r);
  2232.         SetDialogItem(d, item, itype, pptr, r);
  2233.     end;
  2234.     
  2235.     
  2236.  
  2237.     procedure RemoveDensityCalibration;
  2238.     var
  2239.         i:integer;
  2240.     begin
  2241.         for i := 0 to 255 do
  2242.             cvalue[i] := i;
  2243.         info^.fit:=uncalibrated;
  2244.         NoInfo^.fit:=uncalibrated;
  2245.         InvertPixelValues:=false;
  2246.         DrawLabels('', '', '');
  2247.         UpdateTitleBar;
  2248.     end;
  2249.     
  2250.     
  2251.     function isInvertingFunction:boolean;
  2252.     begin
  2253.         with info^ do
  2254.             isInvertingFunction:=(fit=StraightLine) and (nCoefficients=2)
  2255.                 and (Coefficient[1]=255.0) and (Coefficient[2]=-1.0)
  2256.     end;
  2257.     
  2258.     
  2259.     function CheckCalibration: boolean;
  2260.     var
  2261.         result: integer;
  2262.     begin
  2263.         with info^ do begin
  2264.             CheckCalibration := true;
  2265.             if (fit <> uncalibrated) and (not isInvertingFunction) then begin
  2266.                 result := PutMessageWithCancel('This operation will result in loss of density calibration.');
  2267.                 if result = cancel then begin
  2268.                     CheckCalibration := false;
  2269.                     AbortMacro
  2270.                 end else
  2271.                     RemoveDensityCalibration;
  2272.             end;
  2273.         end; {with}
  2274.     end;
  2275.  
  2276.  
  2277.     procedure PlotTooLongMsg;
  2278.     begin
  2279.         PutError(StringOf('Profile plots are limited to ', MaxLine:1, ' pixels.'));
  2280.     end;
  2281.  
  2282.  
  2283. end.